unit HTMLUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ExtCtrls, StdCtrls, ParserCompiler;

type
  THTMLMainForm = class(TForm)
    pnl: TPanel;
    wb: TWebBrowser;
    Scriptbtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ScriptbtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FEngine: TEngine;
    procedure WriteToWebBrowser(S: string; WB: TWebBrowser);
    function FileToString(S: string): string;
    function LoadScript: string;
  public
    { Public declarations }
  end;

var
  HTMLMainForm: THTMLMainForm;

implementation

uses MSHTML, ActiveX, ContantUnit;

{$R *.dfm}

function ReadProc(V: Variant): Variant; stdcall;
begin
  Result := InputBox('Read Box', 'Input:  ', '');
end;

function WriteProc(V: Variant): Variant; stdcall;
begin
  ShowMessage(V);
end;

function THTMLMainForm.FileToString(S: string): string;
var
  Str: string;
  FHnd: THandle;
  FBuf: PChar;
  Size: Cardinal;
begin
  Result := '';
  if not FileExists(S) then Exit;
  FHnd := FileOpen(S, fmOpenRead);
  if FHnd = 0 then Exit;
  Size := GetFileSize(FHnd, nil);
  FBuf := AllocMem(Size + 1);
  FileRead(FHnd, FBuf^, Size);
  Result := StrPas(FBuf);
  FreeMem(FBuf);
  FileClose(FHnd);
end;

procedure THTMLMainForm.WriteToWebBrowser(S: string; WB: TWebBrowser);
var
  IHTMLDoc: IHTMLDocument2;
  psa: PSafeArray;
  ws: WideString;
  varBounds: array [0..63] of TVarArrayBound;
begin
  ws := S;
  varBounds[0].LowBound := 0;
  varBounds[0].ElementCount := 1;
  psa:=SafeArrayCreate(varVariant, 1, varbounds);
  PVarData(psa.pvData).VType := varOleStr;
  PVarData(psa.pvData).VOleStr := PWideChar(ws);
  IHTMLDoc := WB.Document as IHTMLDocument2;
  IHTMLDoc.write(psa);
  IHTMLDoc.close;
  SafeArrayDestroy(psa);
end;

procedure THTMLMainForm.FormCreate(Sender: TObject);
var
  S: string;
begin
  wb.Navigate('about:blank');
  WriteToWebBrowser(FileToString('demo.html'), wb);
  ParserCompiler.ReadProc := ReadProc;
  ParserCompiler.WriteProc := WriteProc;
end;

procedure THTMLMainForm.FormDestroy(Sender: TObject);
begin
  if assigned(FEngine) then
    FreeAndNil(FEngine);
end;

function THTMLMainForm.LoadScript: string;
var
  CForm: TContantForm;
begin
  Result := '';
  CForm := TContantForm.Create(nil);
  if CForm.ShowModal = mrOK then
  Result := CForm.mmo.Text;
  CForm.Free;
end;

procedure THTMLMainForm.ScriptbtnClick(Sender: TObject);
var
  stext: string;
begin
  stext := LoadScript;
  if stext = '' then Exit;
  if assigned(FEngine) then
    FreeAndNil(FEngine);
  FEngine := TEngine.Create(stext);
  FEngine.RegisterSystemVariable('document', True, wb.Document);
  FEngine.RegisterSystemVariable('window', true, IHtmlDocument2(wb.Document).parentWindow);
  FEngine.Parser(False);
  FEngine.Execute;
end;

end.
